|
|
|
 |
|
|
|
About this page
Noticed the new menus available on OfficeXP
and .NET?
On this page you will find a free
OfficeXP-style menu for VB6, plus an article that describes
how to build such a control.
Downloads
| |
It is happening again! a new release of Office is a synonym of a new
user interface.
Now Microsoft has changed the look-and-feel of the
menus in both OfficeXP and VS.NET and all VB developers (including me) are
wondering how they can add this new menu to their programs. It all began
with the flat buttons, remember? We were all searching for free flat
buttons so we could mimic the Office97 toolbars (there are things that
will never change!).
And this is what this article is all about:
how to create an OfficeXP menu for VB6.
First things first: in order to create a menu that has a look different
to the standard we need to use what is called owner-drawn menus. Windows
provides a set of APIs to create menus and by specifying the owner-drawn
flag (MF_OWNERDRAW) we can completely control the appearance of the menu
items.
Let's see an example. Suppose we want to popup an XP menu when we
right-click on our VB6 form. The menu should look something like:
Private Sub Form_MouseDown(
_
Button As Integer,
_
Shift As Integer,
_
X As Single, Y As Single)
Dim pt As
POINTAPI
If Button <>
vbRightButton Then Exit Sub
pt.X = Me.ScaleX(X, vbTwips, vbPixels)
pt.Y = Me.ScaleY(Y, vbTwips, vbPixels)
ClientToScreen Me.hWnd, pt
pShowMenu pt.X,
pt.Y
End Sub
Private Sub pShowMenu(ByVal X As
Long, ByVal Y As Long)
m_MenuHandle = CreatePopupMenu()
AppendMenu
m_MenuHandle, MF_STRING Or MF_OWNERDRAW, 1, 1
AppendMenu m_MenuHandle, MF_STRING Or MF_OWNERDRAW, 2, 2
AppendMenu m_MenuHandle, MF_SEPARATOR Or MF_OWNERDRAW, 3, 3
AppendMenu m_MenuHandle, MF_STRING Or MF_OWNERDRAW, 4, 4
TrackPopupMenuEx _
m_MenuHandle, _
TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_LEFTBUTTON, _
X, _
Y, _
Me.hWnd, _
0
End Sub
The above code will popup a menu every time we right-click on our VB
form, but because the menu has been created with the MF_OWNERDRAW flag, we
will have to respond to the WM_MEASUREITEM and WM_DRAWITEM messages in
order to set the size of every menu item and draw its contents. But how
can we trap these two messages? Well, we can use the SmartSubClass
in order to subclass the form and listen to every message posted to its
window. We will also have to listen for the WM_EXITMENULOOP message in
order to destroy the menu when it closes.
We will need to add the following code:
Dim WithEvents m_Sniff As SmartSubClass
Private Sub
Form_Load()
Set
m_Sniff = New SmartSubClass
m_Sniff.SubClassHwnd Me.hWnd, True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not m_Sniff Is Nothing Then
m_Sniff.SubClassHwnd
Me.hWnd, False
End If
End
Sub
Private Sub m_Sniff_NewMessage(ByVal hWnd As Long, uMsg As Long, wParam As Long, lParam As Long, Cancel
As Boolean)
Select Case uMsg
Case
WM_EXITMENULOOP
If m_MenuHandle <> 0 Then
DestroyMenu
m_MenuHandle
m_MenuHandle
= 0
End If
Case
WM_MEASUREITEM
Call pMenuItemMeasure(lParam)
Case
WM_DRAWITEM
Call pDrawMenuItem(lParam)
End Select
End Sub
The
Subroutine pMenuItemMesure() takes care of returning the size of every
menu item, and the subroutine pDrawMenuItem() takes care of drawing its
contents. If you want more information about these two messages you can
find it on the MSDN.
Well, seems easy, doesn't it? I first thought that by creating
owner-drawn menus I would take FULL control of the painting process and
that I would be able to build XP menus very easily but... I was
wrong! Why? Because owner-drawn menus give you control on how
menu-items are painted but there's no way you can change the menu border.
The menu border always remains 3D.
But menus are basically windows, right? So my second thought was - "if
a menu is using a window to display the menu items, I should be able to
change the window border by subclassing it" - and that's when I started
looking for a function that would return a window handle from a menu
handle but... it doesn't exist.
Menus are a system global class and Windows takes care of creating its
window and handling all its messages. When you create menus using Win32
APIs you don't get any information at all about its window handle.
So what's the solution then? Well, I would like to thank a very good
friend of mine, Garth Oatley, who gave me the answer. He sent me a VB6
project where he was using hooks to trap all windows messages that
belonged to the same thread and he showed me how to detect when a window
belonging to the menu class was created. So thank you Garth!
For those of you who don't have experience using hooks, Microsoft
describes hooks as "A point in the system message-handling mechanism
where an application can install a subroutine to monitor the message
traffic in the system and process certain types of messages before they
reach the target window procedure". In other words, a hook is a way of
subclassing a whole thread. There are different hooks you can create,
depending on the type of message you want to trap. In order to detect when
a menu-window is about to be created, we will use the WH_CALLWNDPROC
hook.
You can find below an example that shows how we can set a hook that
detects when a menu-window is being created in order to subclass it and
modify its border style.
1. First we will need to modify both the Load() and QueryUnload()
events in order to install our own function in the hook-chain.
Private Sub Form_Load()
'
- Get the Process thread...
m_ThreadID
= GetWindowThreadProcessId(hwnd, 0)
' - Install our own hook...
m_HookID = SetWindowsHookEx( _
WH_CALLWNDPROC,
_
AddressOf
pHookCallWndProc, _
0,
_
m_ThreadID)
' - Subclass the window...
Set m_Sniff =
New SmartSubClass
m_Sniff.SubClassHwnd Me.hWnd,
True
End Sub
Private Sub
Form_QueryUnload(Cancel As Integer,
UnloadMode As Integer)
If Not m_Sniff Is Nothing Then
m_Sniff.SubClassHwnd
Me.hWnd, False
End If
If m_HookID
<> 0 Then
UnhookWindowsHookEx
m_HookID
End If
End Sub
2. Add a new module with the following code:
Public Function pHookCallWndProc(
_
ByVal ncode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long)
As Long
Dim CWP
As CWPSTRUCT
Dim lRet As Long
If ncode =
HC_ACTION Then
CopyMemory CWP,
ByVal lParam, Len(CWP)
Select
Case CWP.message
Case WM_CREATE
' - Make sure that the window
'
belongs to the menu class
If pGetClassName(CWP.hwnd) = "#32768" Then
' - Subclass the window...
lRet
= SetWindowLong( _
CWP.hwnd,
_
GWL_WNDPROC,
_
AddressOf
pSubclassWndProc)
' - Store the old windowproc...
SetProp
CWP.hwnd, "OldWndProc", lRet
End If
End
Select
End If
' - Call the next
hook...
pHookCallWndProc =
CallNextHookEx( _
WH_CALLWNDPROC,
_
ncode,
_
wParam,
_
lParam)
End Function
Public Function pSubclassWndProc( _
ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long)
As Long
Dim lRet As Long
Dim lTmp As Long
lRet =
GetProp(hwnd, "OldWndProc")
Select Case uMsg
Case
WM_CREATE
' - Change the window border
'
and make it flat...
lTmp
= GetWindowLong(hwnd, GWL_STYLE)
lTmp
= lTmp And Not WS_BORDER
SetWindowLong
hwnd, GWL_STYLE, lTmp
lTmp
= GetWindowLong(hwnd, GWL_EXSTYLE)
lTmp
= lTmp And Not WS_EX_WINDOWEDGE
lTmp
= lTmp And Not WS_EX_DLGMODALFRAME
SetWindowLong
hwnd, GWL_EXSTYLE, lTmp
Case
WM_DESTROY
' - UnSubclass the window...
RemoveProp
hwnd, "OldWndProc"
SetWindowLong
hwnd, GWL_WNDPROC, lRet
End Select
' - Call the next WindowProc...
pSubclassWndProc = CallWindowProc( _
lRet,
_
hwnd,
_
uMsg,
_
wParam,
_
lParam)
End Function
Public Function
pGetClassName(ByVal hwnd As Long) As String
Dim sClass As String
Dim nLen As Long
sClass = String$(128, Chr$(0))
nLen = GetClassName(hwnd, sClass, 128)
If
nLen = 0 Then
sClass = ""
Else
sClass =
Left$(sClass, nLen)
End If
pGetClassName = sClass
End Function
Ok, let's review the above code with more detail. As
you can see, we use the API SetWindowsHookEx() in the Form_Load() event,
to add our own function to the thread's hook-chain. We are creating a
WH_CALLWNDPROC hook, which means that we'll have access to all messages
before they get their window procedure. In the Form_QueryUnload() event,
we need to unhook in order to prevent a system crash.
Next we have the function pHookCallWndProc(). This function is the
actual hook. Because all the messages of the thread will pass through this
function, we need to make sure that the function is not acting as a
bottle-neck. What that means is to add as little code as we can.
What we do here is to check for the WM_CREATE message and, every time we
trap this message, check that the window belongs to the menu class. A menu
creates a window with its class equal to "#32768" (don't ask me how I know
that!). As soon as we detect that a menu window is about to be created, we
must subclass that window.
Finally, after a menu window has been subclassed, function
pSubclassWndProc() takes care of making its border flat. It does that when
it detects a WM_CREATE message. The function also unsubclasses the window
when message WM_DESTROY is posted.
That's it! by just using two procedures and a couple of APIs we have
created a hook, detected when a menu is about to be created and, by
subclassing that window, convert its 3D border into a flat border.
What's next? We've created menus using the owner-drawn flag, we've used
a hook to modify the window border of the menu and make it flat and...
what about the shadow? As you all probably know, OfficeXP menus have a
very nice feature: there's a shadow on the right-bottom border of their
window. How can we implement this effect?
Well, now that we have created the hook, to add the shadow is quite
simple. We just need to add more code to the function pSubclassWndProc()
in order to draw the shadow every time the message WM_ERASEBKGND is
posted. There's only one trick: the shadow has to be drawn within the menu
window hDC. You can find below an example. You can call this function from
the WM_ERASEBKGND message and you just need to provide the window handle,
its hDC and the position of the window using screen coordinates.
Public Sub DrawMenuShadow( _
ByVal hWnd As Long, _
ByVal hDC As Long, _
ByVal xOrg As Long, _
ByVal yOrg As Long)
Dim hDcDsk As Long
Dim Rec As RECT
Dim winW As Long, winH As Long
Dim X As Long, Y
As Long, c As Long
'- Get the size of the menu...
GetWindowRect hWnd, Rec
winW = Rec.Right - Rec.Left
winH = Rec.Bottom - Rec.Top
'
- Get the desktop hDC...
hDcDsk =
GetWindowDC(GetDesktopWindow)
' - Simulate a shadow on right
edge...
For X = 1
To 4
For
Y = 0 To 3
c
= GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
SetPixel
hDC, winW - X, Y, c
Next
Y
For Y = 4 To 7
c
= GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
SetPixel
hDC, winW - X, Y, pMask(3 * X * (Y - 3), c)
Next
Y
For Y = 8 To winH - 5
c
= GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
SetPixel
hDC, winW - X, Y, pMask(15 * X, c)
Next
Y
For Y = winH - 4 To winH - 1
c
= GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
SetPixel
hDC, winW - X, Y, pMask(3 * X * -(Y - winH), c)
Next
Y
Next X
'
- Simulate a shadow on the bottom edge...
For Y = 1 To 4
For
X = 0 To 3
c
= GetPixel(hDcDsk, xOrg + X, yOrg + winH - Y)
SetPixel
hDC, X, winH - Y, c
Next
X
For X = 4 To 7
c
= GetPixel(hDcDsk, xOrg + X, yOrg + winH - Y)
SetPixel
hDC, X, winH - Y, pMask(3 * (X - 3) * Y, c)
Next
X
For X = 8 To winW - 5
c
= GetPixel(hDcDsk, xOrg + X, yOrg + winH - Y)
SetPixel
hDC, X, winH - Y, pMask(15 * Y, c)
Next
X
Next Y
'
- Release the desktop hDC...
ReleaseDC
GetDesktopWindow, hDcDsk
End Sub
' - Function pMask splits a color
' into
its RGB components and
' transforms the color using
' a scale
0..255
Private Function pMask( _
ByVal lScale As Long, _
ByVal lColor As Long)
As Long
Dim R As Long
Dim G As Long
Dim B As Long
pConvertToRGB lColor, R, G, B
R =
pTransform(lScale, R)
G = pTransform(lScale,
G)
B = pTransform(lScale, B)
pMask = RGB(R, G, B)
End Function
' - Function
pTransform converts
' a RGB subcolor using a scale
' where 0 = 0
and 255 = lScale
Private Function
pTransform( _
ByVal lScale As Long, _
ByVal lColor As Long) As Long
pTransform
= lColor - Int(lColor * lScale / 255)
End Function
SmartMenuXP is a free control that provides VB6 with OfficeXP
look-and-feel menus. You can freely use this control in your
applications.
 |
|
 |
|
This is how SmartMenuXP appears on the
toolbox |
|
This is how SmartMenuXP shows in design
mode |
After you have dropped the SmartMenuXP control on your form you can
easily build your menu by using its property MenuItems.
Let's see an example:
With SmartMenuXP1.MenuItems
.Add 0, "keyFile", ,
"&File"
.Add
"keyFile", , , "&Open...", GetPic(1), vbCtrlMask, vbKeyO
.Add "keyFile", , ,
"&Save...", GetPic(2), vbCtrlMask, vbKeyS
.Add "keyFile", ,
smiSeparator
.Add
"keyFile", , , "E&xit", , vbAltMask, vbKeyQ
End With
You will always use the function MenuList.Add()
to add menuitems to the menu. All parameters in this function are optional
except one: the "Parent" parameter. You can specify the parent by using
either its numeric ID or its key. Menu items that appear on the menu bar
always have Parent=0. The function returns the ID for the new menu
item.
The syntax of MenuList.Add()
is as follows:
After adding a menu item you can read/modify all its properties by
using the MenuItem class.
Example:
SmartMenuXP1.MenuItems.Caption(1) = "Hello
World"
SmartMenuXP1.MenuItems.Enabled(2) = False
Next step after creating the menu items is to decide where you want the
menu to appear. You can place the menu at any point on your form by
setting property Align
= vbAlignNone, or you can stick the menu to the top, bottom, left or right
sides of your form.
Another interesting thing is that you have access to all the different
areas of the menu. You can change the color of these areas by using
properties ArrowColor,
BackColor,
CheckBackColor,
CheckBoxColor,
CheckMarkColor,
FontBackColor,
FontForeColor,
SelBackColor,
SelForeColor,
SelBoxColor
and SeparatorColor.
You can also change the font by using property Font.
SmartMenuXP comes with default values for all these properties so that
you always get the new OfficeXP look-and-feel. However, by changing any of
the properties you can get interesting effects.
|
 |
|
Change the style of your menus
by using the
color properties |
Also, every time a menu item is selected by either using the mouse,
the keyboard, typing its access key (ALT+key) or its shortcut key, the
event Click()
is fired. This event has a parameter that returns the menu item ID.
Private Sub
SmartMenuXP1_Click(ByVal ID As Long)
With
SmartMenuXP1.MenuItems
Select
Case .Key(ID)
Case "keyOpen"
' - Open a file...
Case "keySave"
' - Save a file...
Case "keyExit"
' - Exit the application...
End Select
End With
End
Sub
Finally, you can find below a table containing
all SmartMenuXP properties, methods and events.
Class SmartMenuList
29.Oct.2001 - Build 1.8.0.2
-
On Windows XP the control was displaying two
shadows.
This bug is now fixed. The problem was due to a new
Windows XP system parameter that indicates whether a drop shadow effect
will be active. The parameter is called SPI_GETDROPSHADOW and can be
retrieved by using the API SystemParametersInfo(). The control now
checks for the OS platform and if its equal to "WinXP" the shadow is
hidden. In Windows XP the menu will rely on the OS for creating the
shadow. Also, a new property is now available. Property Shadow
sets whether or not the menu will drop a shadow.
Thanks to Alan
Osman for finding and reporting this bug.
01.Nov.2001 - Build 1.8.0.3
-
It was sometimes impossible to access the
drop-down menu when the menu bar was wrapped.
This bug is now
fixed.
Thanks to Duplex for finding and reporting this
bug.
-
The drop-down menu window wasn't joining the menu
bar correctly when the window was opening bottom-up.
This bug
is now fixed. The shadow effect is now complete and the drop-down
windows are always correctly joined to the menu bar.
Thanks to
George for finding and reporting this bug.
-
Menu buttons weren't showing a shadow on Windows
XP.
This bug is now fixed. Now there's no difference at all
between Windows XP and all other Windows platforms when it comes to
creating a shadow. Also, the button now shows a shadow underneath when
the menu opens bottom-up.
Thanks to Thomas Molitor for finding
and reporting this bug.
-
On Windows XP, the menu was creating a 2 pixel
border rather than a 1 pixel border.
This bug is now fixed
and there's no difference at all between Windows XP and all other
Windows platforms when it comes to drawing the menu.
Thanks again
to Alan Osman for finding and reporting this bug.
-
Three more methods have been
created.
You can use method PopupMenu()
to popup a menu at any point of the screen. There's only one
requirement: in order to use this method the SmartMenuXP control has to
be invisible. Two other functions have also been created. ScreenToClientX()
and ScreenToClientY()
allows you to convert from client points expressed in twips to screen
points expressed in pixels.
Private
Sub Form_MouseDown( _
Button As Integer, _
Shift As Integer, _
X As
Single, _
Y As
Single)
If
Button <> vbRightButton Then Exit Sub
With
SmartMenuXP1
X =
.ClientToScreenX(Me.hWnd, X)
Y =
.ClientToScreenY(Me.hWnd, Y)
.PopupMenu
.MenuItems.Key2ID("kMenu"), X, Y, 0
End With
End Sub
Thanks to Duplex and Phil
Hirst for suggesting this improvement.
06.Nov.2001 - Build 1.8.0.4
-
A new property has been
created.
There's a new property available. SelForeColor
returns or sets the foreground color used to display menu items when
these are highlighted.
Thanks to Phil Hirst for suggesting this
improvement.
-
All properties of a menu item can be now
referenced by using its key.
The SmartMenuItems class has
been modified in order to allow all its properties to be referenced by
either using the menu item ID or the menu item key. The PopupMenu method
has also been modified in order to allow its parameter to be a key
string.
It is now possible to use the following
code:
With
SmartMenuXP1.MenuItems
.Visible("keyFile")
= False
.Caption("KeyView")
= "&View"
End With
Thanks to Tom for suggesting this
improvement.
-
The Visible property wasn't working on menu
items.
This bug is now fixed. Now menu items can be hidden by
setting its Visible
property to False.
Thanks to Morpheus and Tim Mccurdy for finding
and reporting this bug.
-
SmartMenuList class has a new
method.
Now you can remove all menu items by using the new
method Clear.
Thanks
to Morpheus for suggesting this improvement.
06.Nov.2001 (II) - Build
1.8.0.5
-
A new property has been
created.
There's a new property available. This property,
hWnd, returns the window handle of the usercontrol.
Thanks
to Daniel Moreira for suggesting this improvement.
-
The method MenuItems.Clear wasn't refreshing the
menu bar.
This bug is now fixed. After calling the Clear
method the menu bar is refreshed. You should notice that the menu bar
becomes invisible if it contains no items.
-
There seems to be a bug on Windows 95 when control
keys are pressed.
-
There are still problems with Windows XP and themes.
Build 1.8.0.4 works fine under Windows XP with the 'Windows Classic'
theme, but it doesn't work with the 'Windows XP' theme.
|
|
SmartMenuXP.ocx